TITLE	DCSTAT

; BUGS/GRIPES TO BUG-DFTP@MIT-AI

IF1,<
IFNDEF F.TENX,<F.TENX==0>	; NON-ZERO IF FOR TENEX OR TOPS-20
IFNDEF F.ITS,<F.ITS==0>		; NON-ZERO IF FOR ITS
IFNDEF F.TP10,<F.TP10==0>	; NON-ZERO IF FOR TOPS-10
IFNDEF F.SAIL,<F.SAIL==0>	; NON-ZERO IF FOR SAIL

IFN F.TENX,<F.TENX==1
	PRINTX ASSEMBLING TENEX VERSION>
IFN F.ITS,<F.ITS==1
	PRINTX ASSEMBLING ITS VERSION>
IFN F.TP10,<F.TP10==1
	PRINTX ASSEMBLING TOPS-10 VERSION>
IFN F.SAIL,<F.SAIL==1
	PRINTX ASSEMBLING SAIL VERSION>

IFN <F.TENX+F.ITS+F.TP10+F.SAIL>-1,<
	PRINTX ? YOUR SITE SPECIFICATIONS LOSE
	PASS2
	END>
>

; ***DEFINITIONS***

	DCHOST==37
	DCSOKT==703

; REGISTER DEFINITIONS

	R1==1
	R2==2
	R3==3
	R4==4
	R5==5
	R6==6
	R7==7
	R10==10
	R11==11
	R12==12
	R13==13
	R14==14
	R15==15
	R16==16
	R17==17

;	(SCRATCH REGISTERS)
	REG1==1
	REG2==2
	REG3==3
	REG4==4

;	(COMMONLY USED REGISTERS)
	IOREG==R5
	BPREG==R6
	FLAG==R15
	UTIL==R16
	STAK==R17


; MACRO DEFINITIONS

	SALL

DEFINE	BEGINR(SAVLST,%RETN)
<	..SAVL==0
	..SAVC==0
	IFIDN <SAVLST><ALL>,<..SAVL==77777>
	IFDIF <SAVLST><ALL>,<
		IRP SAVLST,<
			IFG <SAVLST>-20,<!!
				PRINTX SAVLST NOT A REGISTER>
			IFLE <SAVLST>-20,<
				IFN ..SAVL&1←SAVLST,<!!
					PRINTX SAVLST SAVED TWICE>
				..SAVL==..SAVL!1←SAVLST
				..SAVC==..SAVC+1>>>
	IFN ..SAVL,<
		..REG==17
		REPEAT 20,<
			IFN ..SAVL&1←..REG,<PUSH STAK,..REG>
			..REG==..REG-1>>
	DEFINE	.%RETN <%RETN>	; UNIQUE LOCATION FOR RETURN AND ENDR
	DEFINE	.%RETL <%RETN':!>
	..SFLG==0		; LARGEST SKIP RETURN
>

; IF RETURN CAN'T BE POPJ, THEN IT ASSEMBLES AS JRST TO ENDR CODE
;   JRST TO .%RETN FOR NOSKIP RETURN, .%RETN-N FOR SKIP RETURN
;   ..SFLG SIGNALS THAT SKIP CODE MUST BE ASSEMBLED IN ENDR
DEFINE	RETURN(SK,N)
<<IFB <SK>,<<IFE ..SAVC,<POPJ STAK,.%RETN>>+<IFN ..SAVC,<JRST .%RETN>>>>+<IFIDN <SK><SKIP>,<<IFG N-..SFLG,<..SFLG==N>>*0+<JRST .%RETN-N>>>>

; RETURN FOR USE WITH CONDITIONAL JUMPS
DEFINE	RETN(N)
<<IFB <N>,<<IFE ..SAVC,<.%RETN>>+<IFN ..SAVC,<.%RETN>>>>+<IFNB <N>,<<IFG N-..SFLG,<..SFLG==N>>*0+<.%RETN-N>>>>

; ENDR DECRIMENTS STAK, RESTORES REGS, RETURNS (POSSIBLY SKIPPING)
DEFINE	ENDR(SK,N)
<	IFB <SK>,<..N==0>
	IFIDN <SK><SKIP>,<..N==N
		IFG <..N-..SFLG>,<..SFLG==..N>>
	IFN <..SFLG>,<IFN <..N-..SFLG>,<JRST .%RETN-..N>
		REPEAT ..SFLG,<
			AOS -..SAVC(STAK)>>
	.%RETL
	..REG==0
	REPEAT 20,<
		IFN ..SAVL&1←..REG,<POP STAK,..REG
			..SAVL==..SAVL-1←..REG>
		..REG==..REG+1>
	POPJ STAK,>

DEFINE	CALLR(ROUTIN)
<	PUSHJ	STAK,ROUTIN>


; SYSTEM DEPENDENT DEFINITIONS

; (((ITS)))
IFN F.ITS,<
	SEARCH SITS
	LOC 150

; INITIALIZATION ROUTINE; MUST DO INIT$G AFTER LOADING TO FLUSH THE
; COMPATABILITY PACKAGE COMPLETELY(AFTER PREVIOUSLY DOING A D SYSTEM
; COMMAND TO DECUUO).
INIT:	MOVSI (JUMPA)
	HRR .JBSA##	; GET DEC START ADDRESS
	.BREAK 12,[400001,,]
	SETZ 1,
	MOVE [1,,2]
	BLT .
	.BREAK 16,100000	; RETURN TO DDT

; I/O CHANNELS

	TTO==1
	ICP==2
	DCI==3
; ITS NETWORK CODES

%NSRFS==4
%NSOPN==5
%NSCLI==10
%NSINP==11

DEFINE TBOUT(REG)
<	.IOT TTO,REG>

DEFINE TSOUT(STRING)
<IRP STRING
<	MOVEI REG1,STRING
	CALLR $STRIN
>>

$STRIN:	BEGINR
	HRLI REG1,(POINT 7,)
$STRI1:	ILDB REG1
	JUMPE RETN(0)
	.IOT TTO,
	JRST $STRI1
	ENDR
DEFINE DCBIN(REG)
<	.IOT DCI,REG
	SKIPE FLAGDD
	 .IOT TTO,REG
>
>
; (((↑↑↑)))

; (((TOPS-10 OR SAIL)))
IFN F.TP10!F.SAIL,<

IFN F.SAIL,<IFNDEF TTCALL,<OPDEF TTCALL [TTYUUO]>>

	SIZBLK==200

	DCCHAN==1

; DEFINITIONS FROM "IMP.MAC"
	.IBDEV==0
	.IBSTT==1
	.IBERR==1
	.IBLCL==2
	.IBHST==3
	.IBRMT==4
	.IUSTT==0
	.IUCON==3
	.IUCLS==4
	.IULSN==5
	.IULHS==15
	.IESOF==5
	.IESKT==11
	.IEDWN==13
	.IETIM==15

DEFINE	TBOUT(REG)
<	TTCALL	1,REG>
DEFINE	TSOUT(STRING)
<	IRP STRING
<	TTCALL	3,STRING>>

DEFINE	DCBIN(REG)
<	SKIPG	DCIBUF+2
	CALLR	NUTMI
	SOS	DCIBUF+2
	ILDB	REG,DCIBUF+1
	JUMPE REG,.-4>
>
; (((↑↑↑)))

; (((TENEX)))
IFN F.TENX,<
	SEARCH	STENEX
DEFINE	TBOUT(REG)
<	IFN	<REG1-REG>,< HRRZI	REG1,(REG)>
	PBOUT>
DEFINE	TSOUT(STRING)
<	IRP STRING
<	HRROI	REG1,STRING
	PSOUT>>

DEFINE	DCBIN(REG)
<	MOVE	REG1,DCIJFN
	BIN
	SKIPN	FLAGDD
	 JRST	.+3
	HRRZI	REG1,(REG2)
	PBOUT
	HRRZI	REG,(REG2)>
>
; (((↑↑↑)))


; ***PROGRAM***

DCSTAT:
IFN F.TP10!F.SAIL,<JFCL>
IFE F.ITS,<RESET>
	MOVE	STAK,[IOWD STSIZ,STBEG]
	CALLR	S$INIT
	SKIPE	FLAGDD
	 JRST	QUIT
	MOVE	IOREG,[ASCII/.I280/]
HEADER:	CALLR	RENPRE
	CALLR	RENLIN
	CAME	IOREG,[ASCII/.I280/]
	 JRST	HEADER
	JRST	TRAILR
STATUS:	DCBIN	<IOREG>
	TBOUT	<IOREG>
	CAIE	IOREG,12
	 JRST	STATUS
TRAILR:	DCBIN	<IOREG>
	CAIE	IOREG," "
	 JRST	FINISH
	MOVEI	IOREG,"]"
	TBOUT	<IOREG>
	MOVEI	IOREG," "
	TBOUT	<IOREG>
	JRST	STATUS
FINISH:	CALLR	RENLIN
	JRST	QUIT


; ***DATACOMPUTER INTERFACE ROUTINES***

; RENLIN -- REQUEST END: PROCEED TO NEW LINE
;
RENLIN:	BEGINR	<IOREG>
RENLNL:	DCBIN	<IOREG>
	CAIE	IOREG,12
	 JRST	RENLNL
	ENDR

; RENLIP -- REQUEST END: PROCEED TO NEW LINE, PRINT MESSAGE
;
RENLIP:	BEGINR	<IOREG>
	SKIPN	FLAGDD
	 JRST	RENLPF
RENLPL:	DCBIN	<IOREG>
	CAIE	IOREG,12
	 JRST	RENLPL
	RETURN
RENLPF:	DCBIN	<IOREG>
	CAIN	IOREG,12
	 RETURN
	CAIE	IOREG,11
	 JRST	RENLPF
	MOVEI	IOREG," "
	TBOUT	<IOREG>
	MOVEI	IOREG,"("
RENLPP:	TBOUT	<IOREG>
	DCBIN	<IOREG>
	CAIE	IOREG,15
	 JRST	RENLPP
	DCBIN	<IOREG>
	MOVEI	IOREG,")"
	TBOUT	<IOREG>
	TSOUT	<CRLF>
	ENDR

; RENPRE -- REQUEST END: RETURN ERROR PREFIX (ASSUMES RENLIN)
;   OUT: IOREG -- ASCII PREFIX (5 BYTES)
;
RENPRE:	BEGINR	<BPREG,UTIL,FLAG>
RENPRP:	SETZ	IOREG,
	MOVE	BPREG,[440700,,IOREG]
	MOVEI	FLAG,5
RENPRL:	DCBIN	<UTIL>
	CAIN	UTIL,15
	 JRST	RENPRL
	CAIN	UTIL,12
	 JRST	RENPRL
	IDPB	UTIL,BPREG
	SOJG	FLAG,RENPRL
	LDB	UTIL,[350700,,IOREG]
	CAIN	UTIL,"?"
	 JRST	DEATH
	CAIE	UTIL,"!"
	 RETURN
	CALLR	RENLIP
	JRST	RENPRP
	ENDR

; DEATH -- FATAL DATACOMPUTER ERROR (? MESSAGE)
;
DEATH:	CALLR	RENLIP
	TSOUT	<[ASCIZ/ ?? FATAL DATACOMPUTER ERROR ??/],CRLF>
; (((ITS)))
IFN F.ITS,<
	.BREAK 16,160000
>
; (((↑↑↑)))
; (((TOPS-10 OR SAIL)))
IFN F.SAIL!F.TP10,<
	EXIT
>
; (((↑↑↑)))
; (((TENEX)))
IFN F.TENX,<
	HALTF
	JRST	.-1
>
; (((↑↑↑)))


; ***SYSTEM DEPENDENT ROUTINES***
; (((ITS)))
IFN F.ITS,<
; SYSTEM INITIALIZATION
;
S$INIT:	BEGINR
	.OPEN TTO,[.UAO,,'TTY']
	 .LOSE 1000
; ITS ICP:		1) GET REMOTE SOCKET NUMBERS FROM ICP SOCKET
;			2) OPEN CONNECTION SOCKET
	.CALL [	SETZ
		SIXBIT/OPEN/
		MOVSI .UII!40050	; 32 BITS, GENSYM SOCKET
		MOVEI ICP
		[('NET')]
		[-1]
		MOVEI DCSOKT
		SETZI DCHOST]
	 JRST ICPLUZ
	.CALL [	SETZ
		SIXBIT/NETBLK/		; WAIT FOR STATE CHANGE
		MOVEI ICP
		MOVEI %NSRFS
		SETZM REG1]
	 .LOSE 1000
	MOVE REG1,[ICP,,RCHBLK]
	.RCHST REG1,
	HRRE REG1,RCHBLK+4
	CAIN REG1,%NSCLI
	 JRST ICPWIN
	CAIE REG1,%NSINP
	 CAIN REG1,%NSOPN
	  JRST ICPWIN
ICPLUZ:	TSOUT <[ASCIZ/DC DEAD/]>
	.BREAK 16,160000
ICPWIN:	MOVE REG1,RCHBLK+1
	ADDI REG1,2
	MOVEM REG1,LCLRCV
	.IOT ICP,REG1
	.CLOSE ICP,
	ADDI REG1,1
	.CALL [	SETZ
		SIXBIT/OPEN/
		MOVSI 40!.UAI
		MOVEI DCI
		[('NET')]
		LCLRCV
		REG1
		SETZI DCHOST]
	 JRST ICPLUZ
	.CALL [	SETZ
		SIXBIT/NETBLK/
		MOVEI DCI
		MOVEI %NSRFS
		SETZM REG1]
	 .LOSE 1000
	JUMPE REG1,ICPLUZ
	ENDR

; NETWORK QUIT -- BREAK DATACOMPUTER CONNECTIONS
;
QUIT:	DCBIN <IOREG>
	JUMPGE IOREG,QUIT
	.BREAK 16,160000
>
; ((↑↑↑)))

; (((TOPS-10 OR SAIL)))
IFN F.TP10!F.SAIL,<
; SYSTEM INITIALIZATION
;
S$INIT:	BEGINR
	MOVE	0,[SIXBIT/DCSTAT/]
	SETNAM	0,
	CALLR	ICP
	ENDR

; (((TOPS-10)))
IFN F.TP10,<
; TOPS-10 ICP:		1) SET CONNECTION SOCKETS IN LISTENING STATE
;			2) GET REMOTE SOCKET NUMBERS FROM ICP SOCKET
;			3) OPEN CONNECTION SOCKETS
;				A) EVEN - RECEIVE
;				B) ODD - SEND
;
ICP:	BEGINR	<IOREG,UTIL,FLAG>
ICPBEG:	SETZM	ICPBLK+.IBDEV
	SETZM	DCIBLK+.IBDEV
	SETZM	DCOBLK+.IBDEV
	SETZM	DCIBLK+.IBRMT
	SETZM	DCOBLK+.IBRMT
	MOVE	IOREG,LINP		; LISTEN ON INPUT SOCKET
	CALL	IOREG,[SIXBIT/IMPUUO/]
	 JRST	.+2
	JRST	ICPICP
	MOVE	IOREG,DCIBLK+.IBERR
	CAIE	IOREG,.IESKT
	 JRST	ICPEIL
	MOVE	IOREG,PWRK
	CALL	IOREG,[SIXBIT/IMPUUO/]
	 JRST	ICPERD
	LDB	REG4,[221100,,WRKBLK+.IBHST] ; NUMBER OF IMP DEVICES
	GETPPN	UTIL,
	HRRZI	UTIL,(UTIL)
	LSH	UTIL,11
	ADDI	UTIL,102
	SETZ	REG3,
	SETZ	FLAG,
ICPRDV:	MOVE	IOREG,[SIXBIT/IMP/]	; RESET DEVICE(S) USED
	MOVEM	IOREG,WRKBLK+.IBDEV
	MOVEI	REG1,(REG3)
	IDIVI	REG1,10
	JUMPE	REG1,ICPRD1
	ADDI	REG1,20
	ADDI	REG2,20
	DPB	REG1,[140600,,WRKBLK+.IBDEV]
	DPB	REG2,[060600,,WRKBLK+.IBDEV]
	JRST	ICPRD2
ICPRD1:	ADDI	REG2,20
	DPB	REG2,[140600,,WRKBLK+.IBDEV]
ICPRD2:	SETZM	WRKBLK+.IBLCL
	MOVE	IOREG,SWRK
	CALL	IOREG,[SIXBIT/IMPUUO/]	; TEST STATUS OF SOCKET
	 JRST	ICPRD3
	HRRZ	IOREG,WRKBLK+.IBHST	; FOREIGN HOST
	CAIE	IOREG,DCHOST
	 JRST	ICPRD3
	PJOB	REG1,
	HLRZ	REG2,WRKBLK+.IBSTT	; OWNING JOB
	CAIE	REG2,(REG1)
	 JRST	ICPRD3
	MOVE	IOREG,WRKBLK+.IBLCL
	CAMN	IOREG,UTIL		; DATALANGUAGE SOCKET(S)
	 JRST	ICPCLS
ICPRD3:	ADDI	REG3,1
	CAIGE	REG3,(REG4)
	 JRST	ICPRDV
	JUMPN	FLAG,ICPBEG
	TTCALL	3,[ASCIZ/ (Connections in use.)/]
	EXIT
ICPCLS:	MOVE	IOREG,CWRK
	CALL	IOREG,[SIXBIT/IMPUUO/]
	 JRST	ICPERD
	MOVEI	IOREG,1
	MOVEM	IOREG,WRKBLK+.IBLCL
	MOVE	IOREG,SWRK
	CALL	IOREG,[SIXBIT/IMPUUO/]
	 JRST	ICPERD
	MOVE	IOREG,CWRK
	CALL	IOREG,[SIXBIT/IMPUUO/]
	 JRST	ICPERD
	TTCALL	3,[ASCIZ/ [Restarting]
/]
	SETO	FLAG,
	JRST	ICPRDV
ICPICP:	MOVE	IOREG,DCIBLK+.IBDEV	; GET DEVICE NAME
	MOVEM	IOREG,DCOBLK+.IBDEV	;   AND COPY IT FOR DUPLEX
	MOVEM	IOREG,DCCHAS+1
	MOVE	IOREG,LOUT		; LISTEN ON OUTPUT SOCKET
	CALL	IOREG,[SIXBIT/IMPUUO/]
	 JRST	ICPEOL
	MOVE	IOREG,OICP
	CALL	IOREG,[SIXBIT/IMPUUO/]	; OPEN CONNECTION
	 JRST	ICPEC
	MOVE	IOREG,ICPBLK+.IBDEV	; GET DEVICE NAME
	MOVEM	IOREG,ICCHAS+1
	OPEN	DCCHAN,ICCHAS		; OPEN AS STANDARD DEVICE
	 JRST	ICPEF
	IN	DCCHAN,
	 JRST	.+2
	JRST	ICPET
	MOVE	IOREG,ICPBUF+1
	MOVE	IOREG,1(IOREG)		; GET THE SOCKET NUMBER
	LSH	IOREG,-4		; RIGHT JUSTIFY 32 BITS
	MOVEM	IOREG,DCOBLK+.IBRMT
	AOJ	IOREG,
	MOVEM	IOREG,DCIBLK+.IBRMT
	RELEAS	DCCHAN,		; CLOSE AS STANDARD DEVICE
	MOVE	IOREG,CICP
	CALL	IOREG,[SIXBIT/IMPUUO/]	; CLOSE CONNECTION
	 JRST	ICPEC
	MOVE	IOREG,OINP		; OPEN INPUT SOCKET
	CALL	IOREG,[SIXBIT/IMPUUO/]
	 JRST	NETEIC
	MOVE	IOREG,OOUT		; OPEN OUTPUT SOCKET
	CALL	IOREG,[SIXBIT/IMPUUO/]
	 JRST	NETEOC
	OPEN	DCCHAN,DCCHAS
	 JRST	NETECF
	OUT	DCCHAN,
	 JRST	.+2
	JRST	NETEOT
	MOVE	IOREG,PWRK
	CALL	IOREG,[SIXBIT/IMPUUO/]
	 JRST	QUIT
	HRRZ	IOREG,WRKBLK+.IBHST
	ENDR
>
; (((↑↑↑)))

; ((((SAIL)))
IFN F.SAIL,<
; SAIL ICP:			THIS ROUTINE WAS SWIPED OFF OF ANOTHER
;				SAIL PROGRAM THAT WORKED; BUT I AM
;				NOT SURE HOW IT WORKS OR WHATEVER!
;				IT SURE IS A LOT MORE COMPLICATED TO
;				ICP ON A TOPS-10 THAN ITS OR TENEX!

; POSITIONS IN MTAPE BLOCK

STLOC==1	; STATUS BITS RETURNED HERE
LSLOC==2	; LOCAL SOCKET
WFLOC==3	; WAIT FLAG
BSLOC==4	; BYTE SIZE LOCATION
FSLOC==5	; FOREIGN SOCKET
HLOC==6		; HOST NUMBER

ERRBTS==763600	; I/O ERROR BITS

ICP:	BEGINR
	PJOB REG2,		; GET JOB #
	MOVSS REG4,REG2		; RECEIVE SOCKET
	ADDI REG4,1		; TRANSMIT SOCKET
	INIT DCCHAN,17
	SIXBIT /IMP/
	0
	 JRST ICPLUZ
	SETZM CONECB
	MOVEM REG2,CONECB+LSLOC
	MOVEI REG3,DCHOST
	MOVEM REG3,CONECB+HLOC
	SETOM CONECB+WFLOC
	MOVEI REG3,40
	MOVEM REG3,CONECB+BSLOC
	MOVEI REG3,DCSOKT
	MOVEM REG3,CONECB+FSLOC
	MTAPE DCCHAN,[
		↑D15
		BYTE (6) 2,24,0,12,12
		]		; TIME OUT CLS, RFNM, RFC, AND INPUT
	MTAPE DCCHAN,CONECB
	STATZ DCCHAN,ERRBTS
	 JRST ICPLUZ		; NO CONNECTION TO LOGGER
	INPUT DCCHAN,[IOWD 1,FRS#
		0]
	STATZ DCCHAN,ERRBTS
	 JRST ICPLUZ		; GOT LOGGER BUT DIDN'T GET SOCKET FROM HIM
	MOVE REG3,FRS
	LSH REG3,-4
	MOVEM REG3,FRS
	ADDI REG3,1
	MOVEM REG3,FSS#
	ADDI REG2,2
	MOVEM REG2,LRS#
	ADDI REG4,2
	MOVEM REG4,LSS#
	MOVE REG1,CONECB+LSLOC
	MOVEM REG1,TERBLK+LSLOC
	MTAPE DCCHAN,TERBLK	; RELEASE LOGGER
	INIT DCCHAN,1
	SIXBIT /IMP/
	XWD DCOBUF,DCIBUF
	 JRST ICPLUZ
	MTAPE DCCHAN,[
		↑D15
		BYTE (6) 5,24,0,12,0
		]		; TIME OUT CLS, RFNM, AND RFC
	MOVEI REG1,↑D8
	DPB REG1,[POINT 6,DCIBUF+1,11]
	DPB REG1,[POINT 6,DCOBUF+1,11]
	MOVEM REG2,CONECB+LSLOC
	MOVEI REG3,DCHOST
	MOVEM REG3,CONECB+HLOC
	SETZM CONECB+WFLOC
	MOVEI REG3,↑D8
	MOVEM REG3,CONECB+BSLOC
	MOVE REG3,FSS
	MOVEM REG3,CONECB+FSLOC
	MTAPE DCCHAN,CONECB
	MOVE REG1,CONECB+STLOC
	TRNN REG1,-1
	 STATZ DCCHAN,ERRBTS
	  JRST ICPLUZ		; CAN'T CONNECT TO RECEIVE SIDE
	CALLR CLSCHK		; SEE IF WE ARE REALLY OPEN
	 JRST ICPLUZ
	AOS CONECB+LSLOC
	SOS CONECB+FSLOC
	MOVEI REG3,↑D8
	MOVEM REG3,CONECB+BSLOC
	MTAPE DCCHAN,CONECB
	MOVE REG1,CONECB+STLOC
	TRNN REG1,-1
	 STATZ DCCHAN,ERRBTS
	  JRST ICPLUZ		; CAN'T CONNECT TO SEND SIDE
	CALLR CLSCHK
	 JRST ICPLUZ
	MOVEI REG3,4
	MOVEM REG3,CONECB
	MTAPE DCCHAN,CONECB
	MOVE REG1,CONECB+STLOC
	TLC REG1,300000
	TLCN REG1,300000
	 TLNE REG1,060000
	  JRST ICPLUZ
	STATZ DCCHAN,ERRBTS
	 JRST ICPLUZ
	SOS CONECB+LSLOC
	CALLR CLSCHK
	 JRST ICPLUZ
	MTAPE DCCHAN,CONECB
	MOVE REG1,CONECB+STLOC
	TLC REG1,300000
	TLCN REG1,300000
	 TLNE REG1,060000
	  JRST ICPLUZ
	STATZ DCCHAN,ERRBTS
	 JRST ICPLUZ		; LOST WHILE WAITING FOR RECEIVE SIDE TO CONNECT
	CALLR CLSCHK
	 JRST ICPLUZ
	RETURN

; HERE WHEN CONNECTION FAILS

ICPLUZ:	OUTSTR [ASCIZ/? Cannot establish network connection/]
	EXIT
	ENDR
>
; (((↑↑↑)))

; NETWORK QUIT -- BREAK DATACOMPUTER CONNECTIONS
;
QUIT:	INPUT	DCCHAN,
	STATZ	DCCHAN,20000
	 JRST	QUIT01
	SKIPN	FLAGDD
	 JRST	QUIT
	HRRZ	REG1,DCIBUF
	CALLR	NUTDD
	JRST	QUIT
QUIT01:	RELEAS	DCCHAN,		; RELEASE INPUT/OUTPUT DEVICE
QUIT02:	IFN F.TP10,<
	MOVE	IOREG,COUT		; CLOSE OUTPUT SOCKET
	CALL	IOREG,[SIXBIT/IMPUUO/]
	 JRST	NETEOC
>
QUIT03:	IFN F.TP10,<
	MOVE	IOREG,CINP		; CLOSE INPUT SOCKET
	CALL	IOREG,[SIXBIT/IMPUUO/]
	 JRST	NETEIC
>
	RESET
	EXIT

; NETWORK UTILITY -- MESSAGE INPUT
;
NUTMI:	BEGINR
	IN	DCCHAN,
	 JRST	.+2
	JRST	NETEIT
	SKIPE	FLAGDD
	 CALLR	NUTDD
	ENDR

; NETWORK UTILITY -- DISPLAY DATALANGUAGE
;   IN: REG1 -- POINTER TO BUFFER HEADER
;
NUTDD:	BEGINR	<IOREG,UTIL>
	MOVE REG1,DCIBUF+1
	MOVE UTIL,DCIBUF+2
NUTDDL:	SOJL	UTIL,RETN(0)
	ILDB	IOREG,REG1
	JUMPE	IOREG,NUTDDL
	TTCALL	1,IOREG
	JRST	NUTDDL
	ENDR

; FATAL NETWORK ERROR MESSAGES
;
; (((TOPS-10)))
IFN F.TP10,<
ICPERD:	TTCALL	3,[ASCIZ/ ?? RESTART FAILURE ??/]
	EXIT
ICPEIL:	TTCALL	3,[ASCIZ/ ?? INPUT SOCKET LISTEN FAILURE ??/]
	EXIT
ICPEOL:	TTCALL	3,[ASCIZ/ ?? OUTPUT SOCKET LISTEN FAILURE ??/]
	JRST	QUIT03
ICPET:	TTCALL	3,[ASCIZ/ ?? ICP FAILURE (TRANSFER) ??/]
	RELEAS	DCCHAN,		; CLOSE AS STANDARD DEVICE
ICPEZ:	MOVE	IOREG,CICP
	CALL	IOREG,[SIXBIT/IMPUUO/]	; CLOSE CONNECTION
	 JRST	ICPEC
	JRST	QUIT02
ICPEF:	TTCALL	3,[ASCIZ/ ?? ICP FAILURE (FILE CONTROL) ??/]
	JRST	ICPEZ
ICPEC:	TTCALL	3,[ASCIZ/ The datacomputer is unavailable/]
	MOVE	0,ICPBLK+.IBERR
	CAIN	0,.IESOF	; SOCKET OPEN FAILURE
	 TTCALL	3,[ASCIZ/ (rejecting)/]
	CAIN	0,.IEDWN
	 TTCALL	3,[ASCIZ/ (down)/]
	CAIN	0,.IETIM
	 TTCALL	3,[ASCIZ/ (timeout)/]
	TTCALL	3,[ASCIZ/.
/]
	MOVE	IOREG,CICP
	CALL	IOREG,[SIXBIT/IMPUUO/]
	 JRST	QUIT02
	JRST	QUIT02
NETEIC:	TTCALL	3,[ASCIZ/ ?? INPUT FAILURE (CONNECTION) ??/]
	EXIT
NETEOC:	TTCALL	3,[ASCIZ/ ?? OUTPUT FAILURE (CONNECTION) ??/]
	JRST	QUIT03
NETECF:	TTCALL	3,[ASCIZ/ ?? FILE CONTROL FAILURE ??/]
	JRST	QUIT02
>
; (((↑↑↑)))
NETEIT:	TTCALL	3,[ASCIZ/ ?? INPUT FAILURE (TRANSFER) ??/]
	JRST	QUIT
NETEOT:	TTCALL	3,[ASCIZ/ ?? OUTPUT FAILURE (TRANSFER) ??/]
	JRST	QUIT

; (((TOPS-10)))
IFN F.TP10,<
OICP:	.IUCON,,ICPBLK
CICP:	.IUCLS,,ICPBLK
LINP:	.IULSN,,DCIBLK
OINP:	.IUCON,,DCIBLK
CINP:	.IUCLS,,DCIBLK
LOUT:	.IULSN,,DCOBLK
OOUT:	.IUCON,,DCOBLK
COUT:	.IUCLS,,DCOBLK
PWRK:	.IULHS,,WRKBLK
SWRK:	.IUSTT,,WRKBLK
CWRK:	.IUCLS,,WRKBLK
>
; (((↑↑↑)))
; (((SAIL)))
IFN F.SAIL,<
CLSCHK:	BEGINR
	MTAPE DCCHAN,STTBLK
	MOVE REG1,STTBLK+1
	IOR REG1,STTBLK+2
	STATO DCCHAN,ERRBTS
	 TLNN REG1,060000
	  RETURN SKIP,1
	ENDR
>
; (((↑↑↑)))
>
; (((↑↑↑)))

; (((TENEX)))
IFN F.TENX,<
; SYSTEM INITIALIZATION
;
S$INIT:	BEGINR
	MOVE	REG1,[SIXBIT/DCSTAT/]
	SETNM
	MOVEI	REG1,400000	; FOR THIS FORK
	MOVE	REG2,[LEVTAB,,CHNTAB]
	SIR			; SET UP INTERRUPT TABLES
	EIR			; ENABLE INTERRUPTS
	MOVEI	REG1,400000	; FOR THIS FORK
	MOVE	REG2,[1B10+1B15] ; TTY, EOF, ILI
	AIC			; ACTIVATE CHANNELS
	SETZM	FLAGEF
	CALLR	ICP
	ENDR

; TENEX ICP:		1) GET REMOTE SOCKET NUMBERS FROM ICP SOCKET
;			2) OPEN CONNECTION SOCKETS
;				A) EVEN - INPUT
;				B) ODD - OUTPUT
; JFN STRING:	"NET:<JOB-RELATIVE-SKT>.<FOREIGN-HST>-<FOREIGN-SKT>"
;
ICP:	BEGINR
	MOVE	REG1,[440700,,BUFFER]
	HRROI	REG2,[ASCIZ/NET:20./]
	SETZ	REG3,
	SOUT			; LOCAL SOCKET 20+JOBREL
	MOVEI	REG2,DCHOST
	MOVEI	REG3,10
	CVHST
	 NOUT			; FAILURE -- MAKE HOST # INTO STRING
	 JRST	.+1		; CVHST SUCCESS OR NOUT FAILURE
	MOVN	REG2,DCSOCK
	NOUT
	 JRST	.+1
	HRLZI	REG1,1	; SHORT GTJFN
	HRROI	REG2,BUFFER
	GTJFN			; ICP CONNECTION
	 JRST	ICPEG
	MOVE	REG2,[40B5+1B19] ; 32-BIT, READ
	OPENF			; OPEN ICP CONNECTION
	 JRST	ICPEO
	BIN
	MOVEM	REG2,ICPSOC
	CLOSF
	 JRST	ICPEC
	MOVE	REG1,[440700,,BUFFER]
	HRROI	REG2,[ASCIZ/NET:22./]
	SETZ	REG3,
	SOUT
	MOVEI	REG2,DCHOST
	MOVEI	REG3,10
	CVHST
	 NOUT
	 JRST	.+1
	MOVN	REG2,ICPSOC
	NOUT
	 JRST	.+1
	HRLZI	REG1,1
	HRROI	REG2,BUFFER
	GTJFN			; OUTPUT JFN
	 JRST	ICPEIG
	MOVEM	REG1,DCOJFN
	HRLZI	REG1,1
	HRROI	REG2,BUFFER
	GTJFN			; INPUT JFN
	 JRST	ICPEOG
	MOVEM	REG1,DCIJFN
	MOVE	REG2,[10B5+6B9+1B19] ; 8-BIT, NO-WAIT, READ
	OPENF
	 JRST	ICPEIO
	MOVE	REG1,DCOJFN
	MOVE	REG2,[10B5+7B9+1B20] ; 8-BIT, NO-WAIT-BUFFERED, WRITE
	OPENF
	 JRST	ICPEOO
	ENDR

; NETWORK QUIT
;
QUIT:	SETOM	FLAGEF
QUIT01:	DCBIN	<IOREG>
	SKIPE	FLAGEF
	 JRST	QUIT01
	RESET
	HALTF
	JRST	.-1		; IN CASE OF "CONTINUE"

; FATAL NETWORK ERROR MESSAGES
;
NETEQ:	PSOUT
	RESET
	HALTF
	JRST	.-1
ICPEG:	HRROI	REG1,[ASCIZ/ The datacomputer is unavailable (network)./]
	JRST	NETEQ
ICPEO:	HRROI	REG1,[ASCIZ/ The datacomputer is unavailable (down)./]
	JRST	NETEQ
ICPEC:	HRROI	REG1,[ASCIZ/ ?? ICP CLOSF FAILURE ??/]
	JRST	NETEQ
ICPEOG:	HRROI	REG1,[ASCIZ/ ?? ICP OUTPUT GTJFN FAILURE ??/]
	JRST	NETEQ
ICPEIG:	HRROI	REG1,[ASCIZ/ ?? ICP INPUT GTJFN FAILURE ??/]
	JRST	NETEQ
ICPEIO:	HRROI	REG1,[ASCIZ/ ?? ICP OUTPUT OPENF FAILURE ??/]
	JRST	NETEQ
ICPEOO:	HRROI	REG1,[ASCIZ/ ?? ICP INPUT OPENF FAILURE ??/]
	JRST	NETEQ

; PSEUDO-INTERRUPT ROUTINES
;
EOFPSI:	SKIPN	FLAGEF
	 JRST	EOFPSE
	SETZM	FLAGEF
	DEBRK			; RETURN FROM INTERRUPT
EOFPSE:	HRROI	REG1,[ASCIZ/ ?? UNEXPECTED EOF AT /]
	PSOUT
	MOVEI	REG1,101
	HRRZ	REG2,PSIPC1
	SUBI	REG2,1
	MOVEI	REG3,10
	SETZ	REG4,
	NOUT
	 JRST	.+1
	HRROI	REG1,[ASCIZ/ ??
/]
	PSOUT
	HALTF
	JRST	.-1
ILIPSI:	HRRZ	REG1,PSIPC1
	MOVE	REG2,-1(REG1)
	HRROI	REG1,[ASCIZ/ ?? ILLEGAL INSTRUCTION AT /]
	CAMN	REG2,[-1]
	 HRROI	REG1,[ASCIZ/ ?? IMPOSSIBLE EVENT AT /]
	PSOUT
	MOVEI	REG1,101
	HRRZ	REG2,PSIPC1
	SUBI	REG2,1
	MOVEI	REG3,10
	SETZ	REG4,
	NOUT
	 JRST	.+1
	HRROI	REG1,[ASCIZ/ ??
/]
	PSOUT
	HALTF
	JRST	.-1
>
; (((↑↑↑)))


; ***DATA***

	LIT			; LITERALS GO HERE

CRLF:	BYTE	(7)15,12,0,0,0

; (((ITS)))
IFN F.ITS,<
RCHBLK:	BLOCK 10
LCLRCV:	BLOCK 1
>
; (((↑↑↑)))

; (((TOPS-10)))
IFN F.TP10,<

ICPBLK:	SIXBIT	/IMP/
	0
	100			; LOCAL SOCKET
	40,,DCHOST		; 32 BIT BYTES (ICP), CCA HOST
	DCSOKT			; DATACOMPUTER SOCKET
DCIBLK:	SIXBIT	/IMP/
	0
	102			; LOCAL SOCKET
	10,,DCHOST		; 8 BIT BYTES, HOST
	0			; CCA SOCKET FROM ICP + 1
DCOBLK:	SIXBIT	/IMP/
	0
	103			; LOCAL SOCKET
	10,,DCHOST		; 8 BIT BYTES, HOST
	0			; CCA SOCKET FROM ICP
WRKBLK:	BLOCK	5
ICCHAS:	10			; IMAGE MODE
	SIXBIT	/IMP/
	0,,ICPBUF
ICPBUF:	BLOCK	3
DCCHAS:	0			; 7 BIT ASCII MODE
	SIXBIT	/IMP/
	DCOBUF,,DCIBUF
>
; (((↑↑↑)))
; (((SAIL)))
IFN F.SAIL,<
CONECB:	BLOCK 7
STTBLK:	2
	BLOCK 2
TERBLK:	3
	0
	1
	0
>
; (((↑↑↑)))
; (((TOPS-10 OR SAIL)))
IFN F.TP10!F.SAIL,<
DCIBUF:	BLOCK	3
DCOBUF:	BLOCK	3
>
; (((↑↑↑)))

; (((TENEX)))
IFN F.TENX,<
LEVTAB:	PSIPC1
	PSIPC2
	PSIPC3
PSIPC1:	BLOCK	1
PSIPC2:	BLOCK	1
PSIPC3:	BLOCK	1
CHNTAB:	REPEAT ↑D10,<EXP 0>
	1,,EOFPSI
	REPEAT 4,<EXP 0>
	1,,ILIPSI
	REPEAT ↑D20,<EXP 0>
FLAGEF:	0

DCSOCK:	DCSOKT
ICPSOC:	0			; ICP SOCKET
DCIJFN:	0			; DC INPUT JFN
DCOJFN:	0			; DC OUTPUT JFN
>
; (((↑↑↑)))

; * VARIABLES

FLAGDD:	0

BUFFER:	BLOCK	100

	STSIZ==100
STBEG:	BLOCK	STSIZ



	END	DCSTAT
ββββ